perm filename B[NEW,LCS] blob
sn#519458 filedate 1980-07-01 generic text, type T, neo UTF8
C22 IF(J11.EQ.0)GO TO 122
CC IF(MOD(J11,2).EQ.0)J11=J11+1
C MAKE SURE WE HAVE AN ODD NUMBER OF SEGMENTS FOR DASHES.
C J11=3
C KD=2
C KT=0
C KA=1
C THIS WILL MAKE DASHED SLURS J11 HAS DASH SIZE.
C DO 188 K=J6,J7,J5
C KT=KT+1
C IF(KT.LT.J11)GO TO 188
C KT=0
C KD=KD+KA
C KA=-KA
C BLANK-DASH FLIP-FLOP
C188 CALL LINES(SLURX(K),SLURY(K),KD)
C GO TO 123
C122 DO 88 K=J6,J7,J5
C88 CALL LINES(SLURX(K),SLURY(K),2)
123 IF(J5.GT.1)CALL LINES(SLURX(L),SLURY(L),2)
C DISPLAY END POINT OF SLUR
IF(TWICE)RETURN
TWICE=TWICE-1
GO TO 182
180 RW=R+R7*RST7
TWICE=-1
CC KQ=1
J5=1
RX=RX+R3
CC RA=(R5-R4)*RST7
IF(J9.EQ.0)GO TO 181
RZ=RTILT/(RX-R3)
TWICE=2
CC RZ=RX-R3
RXX=RX
RWID=(R3+RXX)/2.
182 IF(TWICE.EQ.1)GO TO 183
C DOES LEFT SIDE FIRST.
IF(TWICE.EQ.0)GO TO 184
C LAST IS NUMBER.
J8=2
RC=RSTJ2*13.
RX=RWID-RC
RWW=RTILT
185 RTILT=RZ*(RX-R3)
C PUT IN FUNC. HERE FOR THIS SLOPE AND FOR PART. BEAMS.
GO TO 181
183 J8=3
RX=RXX
RTILT=RWW
RXX=R3
R3=RWID+RC
RXX=RZ*(R3-RXX)
R=R+RXX
RW=RW+RXX
GO TO 185
181 SLURX(1)=R3
SLURY(1)=R
SLURX(2)=R3
SLURY(2)=RW
SLURX(3)=RX
SLURY(3)=RW+RTILT
SLURX(4)=RX
SLURY(4)=R+RTILT
L=4
IF(J8.EQ.2)L=3
IF(J8.EQ.3)J10=2
IF(R10.EQ.0)GO TO 87
C 1ST AND 2ND ENDING BRACKET. P10=1 OR 2. YOU MUST SET OTHER PARAM.
C ST P7=8 P8=1. FOR 2ND ENDING USE P8=2
R4=R4+R7-4.5
R5=1.
RX=18.
J3=R3+RX*RSTJ2
R6=50003899.+R10*10000.
1181 CALL ALPHA
J5=1
GO TO 87
184 J3=RWID
C PUT IN VERT. POS. WHEN SLOPE!
R4=RQQ/2.+R4+R7-1.
R6=0.875
C SIZE(R6) IS 0.875 R7=1 IS FOR ITALICS
R7=1
R8=0
CALL MAKNUM(R9)
END
SUBROUTINE SCL
C SETS UP SCALING MARKERS.
COMMON /STF/RSTFAC(0/7),RSTJ2 /RINP/SU(900)
COMMON R2,JA,CT,J2,R3,R4,R5,RJQ(17),J3,J4,J5,J6,J(16)
1 /POSI/STFF(0/7),J102,POS
J2=R2
IF(J2.NE.99)GO TO 1008
CALL HYDPOG(2)
RETURN
1008 J5=0
J6=0
RSTJ2=RSTFAC(J2)
C SETS UP SCALE LINES.
J4=200
IF(R3.NE.0)J4=400
C PUTS SCALE TO 400
R2=STFF(J2)+60.*RSTJ2
RJ=R2+60.
CALL DPYSET(2,SU,700)
CALL DPYBRT(3)
POS=RJ+40.
RSTJ2=1.
DO 1002 MX=10,J4,10
RA=RHORZ(FLOAT(MX))
R3=RA-58
IF(MX.GT.10)CALL PNUM
CC1005 IF(R5.NE.0)GO TO 1007
C JUMP FOR STAFF NUMBERS
CALL LINX(RA,R2,RA,RJ)
J5=J5+1
1002 IF(J5.EQ.10)J5=0
CALL LINES(-596.0,RJ,2)
CALL LINES(-596.0,R2,2)
R6=1.5
C NEXT SETS UP STAFF NUMBERS TO FAR RIGHT(OUT OF WAY OF TYPING.)
R3=615.
DO 1007 K=0,7
POS=STFF(K)+40.
J5=IABS(K)
CALL PNUM
1007 CONTINUE
CC CALL DPYDO(2)
CALL DPYOUT(2)
CALL SETPOG(1)
END
FUNCTION IBLANK(IS,N)
COMMON /XRN/RN(2000)